structure Tree :> TREE =
struct
  structure Node =
  struct
    datatype 'a t =
      T of {successors : 'a t list ref,
            content : 'a option}
            
    fun 'a new x =
        T {successors = ref [],
           content = SOME x}
    
    fun content (T {content, ...}) = valOf content
    
    fun equals (T {successors = s1, ...}, T {successors = s2, ...}) =
        s1 = s2
    
    fun hasEdge (T {successors, ...}, to) =
        List.exists (fn x => equals (x, to)) (!successors)
            
    fun addSuccessor (T {successors, ...}, to) =
        successors := to :: (!successors)    
            
    fun successors (T {successors, ...}) = !successors
    
    fun junk _ = "junk"
  end
  
  datatype 'a t =
    T of {nodes : 'a Node.t list ref}     
  
  fun addNode (T {nodes, ...}, n) =
      nodes := n :: (!nodes)
      

  fun new () = T {nodes = ref []}
  
  fun newNode (T {nodes, ...}, x) =
      let val n = Node.new x
          val _ = nodes := n :: (!nodes)
      in  n
      end     
  
  fun nodes (T {nodes, ...}) = !nodes
  
  fun hasEdge (g, {from, to}) =
      let val succs = Node.successors from
      in  List.exists (fn y => Node.equals (to, y)) succs
      end
    
      
  fun toDot (g, name, convert) =
      let fun trans (T {nodes, ...}) =
              let val glist = !nodes
                  fun cookSuccs l =
                      case l
                       of [] => []
                        | node :: xs =>
                          let val succs = Node.successors node
                              fun cook (h, l) =
                                  case l
                                   of [] => []
                                    | x :: xs =>
                                      let val nodex = ()                                     
                                      in  {head = convert h, tail = convert x}
                                          :: (cook (h, xs))                                      
                                      end
                              val one = cook (node, succs)
                              val res = cookSuccs xs
                          in  (one @ res)
                          end
                  val contents = Dot.Content.T (cookSuccs glist)
              in  Dot.T {name = name,
                         size = {width = 10, height = 10},
                         node = {color = "lightblue2", style ="filled"},
                         contents = contents}
              end 
          val dot = trans g
      in  Dot.outputFile (dot)
      end
         
  fun addEdge (g as T {nodes, ...}, {from, to}) =
      if hasEdge (g, {from = from, to = to})
      then ()
      else let val _ = 
                   case (List.find (fn x => Node.equals (x, from)) (!nodes),
                         List.find (fn x => Node.equals (x, to)) (!nodes))
                    of (NONE, NONE) =>
                       let val _ = addNode (g, from)
                           val _ = addNode (g, to)
                       in  addEdge (g, {from = from, to = to})
                       end
                     | (NONE, _) =>
                       let val _ = addNode (g, from)
                       in  addEdge (g, {from = from, to = to})
                       end
                     | (_, NONE) =>
                       let val _ = addNode (g, to)
                       in  addEdge (g, {from = from, to = to})
                       end
                     | (SOME n, _) =>
                       let val _ =  Node.addSuccessor (from, to)
                       in  ()
                       end
           in  ()
           end
           
  
  
  fun numNodes (T {nodes, ...}) = List.length (!nodes)
  
  fun foreachNode (T {nodes, ...}) f =
      List.app f (!nodes)
      
  
end
